library(dplyr)
library(DT)
borough_dead <- trees_with_dist |>
st_drop_geometry() |>
mutate(
cond = tolower(trimws(tpcondition)),
Borough = case_when(
CounDist >= 1 & CounDist <= 10 ~ "Manhattan",
CounDist >= 11 & CounDist <= 18 ~ "Bronx",
CounDist >= 19 & CounDist <= 32 ~ "Queens",
CounDist >= 33 & CounDist <= 48 ~ "Brooklyn",
CounDist >= 49 & CounDist <= 51 ~ "Staten Island",
TRUE ~ "Other"
)
) |>
filter(!is.na(cond), cond != "", Borough %in% c("Manhattan","Bronx","Queens","Brooklyn","Staten Island")) |>
group_by(Borough) |>
summarise(
dead_trees = sum(cond == "dead"),
total_known = n(),
frac_dead = dead_trees / total_known,
.groups = "drop"
) |>
arrange(desc(frac_dead))
borough_dead_df <- datatable(
borough_dead |>
mutate(
`Dead Trees` = scales::comma(dead_trees),
`Known Trees` = scales::comma(total_known),
`Fraction Dead`= scales::percent(frac_dead, accuracy = 0.1)
) |>
select(Borough, `Dead Trees`, `Known Trees`, `Fraction Dead`),
caption = "Dead-tree fraction by borough",
rownames = FALSE,
options = list(searching = FALSE, info = FALSE)
)
TOP_BOROUGH <- borough_dead |> slice(1) |> pull(Borough)
district_dead_top_boro <- trees_with_dist |>
st_drop_geometry() |>
mutate(
cond = tolower(trimws(tpcondition)),
Borough = case_when(
CounDist >= 1 & CounDist <= 10 ~ "Manhattan",
CounDist >= 11 & CounDist <= 18 ~ "Bronx",
CounDist >= 19 & CounDist <= 32 ~ "Queens",
CounDist >= 33 & CounDist <= 48 ~ "Brooklyn",
CounDist >= 49 & CounDist <= 51 ~ "Staten Island",
TRUE ~ "Other"
)
) |>
filter(Borough == TOP_BOROUGH, !is.na(cond), cond != "") |>
group_by(CounDist) |>
summarise(
dead_trees = sum(cond == "dead"),
total_known = n(),
frac_dead = dead_trees / total_known,
.groups = "drop"
) |>
arrange(desc(frac_dead))
district_dead_top_boro_df <- datatable(
district_dead_top_boro |>
mutate(
`Dead Trees` = scales::comma(dead_trees),
`Known Trees` = scales::comma(total_known),
`Fraction Dead`= scales::percent(frac_dead, accuracy = 0.1)
) |>
select(`Council District` = CounDist, `Dead Trees`, `Known Trees`, `Fraction Dead`),
caption = paste("Dead-tree fraction by district in", TOP_BOROUGH),
rownames = FALSE,
options = list(searching = FALSE, info = FALSE)
)
if(!require("patchwork")) install.packages("patchwork")
library(sf)
library(ggplot2)
library(patchwork)
library(sf)
library(dplyr)
library(leaflet)
library(crosstalk)
# 1) Pick the borough with the highest dead-tree fraction, then its top/bottom districts
borough_dead <- trees_with_dist |>
st_drop_geometry() |>
mutate(
cond = tolower(trimws(tpcondition)),
Borough = case_when(
CounDist >= 1 & CounDist <= 10 ~ "Manhattan",
CounDist >= 11 & CounDist <= 18 ~ "Bronx",
CounDist >= 19 & CounDist <= 32 ~ "Queens",
CounDist >= 33 & CounDist <= 48 ~ "Brooklyn",
CounDist >= 49 & CounDist <= 51 ~ "Staten Island",
TRUE ~ "Other"
)
) |>
filter(Borough %in% c("Manhattan","Bronx","Queens","Brooklyn","Staten Island"),
!is.na(cond), cond != "") |>
group_by(Borough) |>
summarise(
dead_trees = sum(cond == "dead"),
total_known = n(),
frac_dead = dead_trees / total_known,
.groups = "drop"
) |>
arrange(desc(frac_dead))
TOP_BOROUGH <- borough_dead |> slice(1) |> pull(Borough)
district_dead_top_boro <- trees_with_dist |>
st_drop_geometry() |>
mutate(
cond = tolower(trimws(tpcondition)),
Borough = case_when(
CounDist >= 1 & CounDist <= 10 ~ "Manhattan",
CounDist >= 11 & CounDist <= 18 ~ "Bronx",
CounDist >= 19 & CounDist <= 32 ~ "Queens",
CounDist >= 33 & CounDist <= 48 ~ "Brooklyn",
CounDist >= 49 & CounDist <= 51 ~ "Staten Island",
TRUE ~ "Other"
)
) |>
filter(Borough == TOP_BOROUGH, !is.na(cond), cond != "") |>
group_by(CounDist) |>
summarise(
dead_trees = sum(cond == "dead"),
total_known = n(),
frac_dead = dead_trees / total_known,
.groups = "drop"
) |>
arrange(desc(frac_dead))
TOP_DIST <- district_dead_top_boro |> slice(1) |> pull(CounDist)
BOT_DIST <- district_dead_top_boro |> slice(n()) |> pull(CounDist)
# 2) Prep data for mapping (WGS84, filter to the two districts)
DISTRICTS_4326 <- st_transform(districts, 4326)
TREES_4326 <- st_transform(trees_with_dist, 4326) |>
mutate(cond = tolower(trimws(tpcondition))) |>
filter(cond %in% c("fair","good","dead","excellent","poor"))
poly_top <- DISTRICTS_4326 |> filter(CounDist == TOP_DIST)
poly_bot <- DISTRICTS_4326 |> filter(CounDist == BOT_DIST)
pts_top <- TREES_4326 |> filter(CounDist == TOP_DIST)
pts_bot <- TREES_4326 |> filter(CounDist == BOT_DIST)
# 3) Discrete condition palette (exact colors you asked for)
COND_LEVELS <- c("dead","excellent","poor","fair","good")
PAL_VEC <- c(dead = "#DC2626", # red
excellent = "#15803D", # green (darker)
poor = "#F97316", # orange
fair = "#FACC15", # yellow
good = "#86EFAC") # lighter green
pal <- colorFactor(palette = PAL_VEC[COND_LEVELS], domain = COND_LEVELS)
# 4) Build the two maps
m_top <- leaflet(options = leafletOptions(minZoom = 9)) |>
addProviderTiles(providers$CartoDB.Positron) |>
addPolygons(data = poly_top,
color = "#334155", weight = 1.3, fill = FALSE) |>
addCircleMarkers(data = pts_top,
radius = 2, stroke = FALSE, fillOpacity = 0.6,
color = ~pal(cond),
popup = ~paste0("<b>Condition:</b> ", tpcondition,
"<br><b>Species:</b> ", genusspecies)) |>
addLegend("bottomleft", pal = pal, values = COND_LEVELS,
title = paste0("Tree Condition\n(Top: D.", TOP_DIST, " — ", TOP_BOROUGH, ")"),
opacity = 1) |>
fitBounds(lng1 = st_bbox(poly_top)[["xmin"]], lat1 = st_bbox(poly_top)[["ymin"]],
lng2 = st_bbox(poly_top)[["xmax"]], lat2 = st_bbox(poly_top)[["ymax"]])
m_bot <- leaflet(options = leafletOptions(minZoom = 9)) |>
addProviderTiles(providers$CartoDB.Positron) |>
addPolygons(data = poly_bot,
color = "#334155", weight = 1.3, fill = FALSE) |>
addCircleMarkers(data = pts_bot,
radius = 2, stroke = FALSE, fillOpacity = 0.6,
color = ~pal(cond),
popup = ~paste0("<b>Condition:</b> ", tpcondition,
"<br><b>Species:</b> ", genusspecies)) |>
addLegend("bottomleft", pal = pal, values = COND_LEVELS,
title = paste0("Tree Condition\n(Lowest: D.", BOT_DIST, " — ", TOP_BOROUGH, ")"),
opacity = 1) |>
fitBounds(lng1 = st_bbox(poly_bot)[["xmin"]], lat1 = st_bbox(poly_bot)[["ymin"]],
lng2 = st_bbox(poly_bot)[["xmax"]], lat2 = st_bbox(poly_bot)[["ymax"]])
# 5) Display side-by-side (leaflet doesn't support facet_wrap; this lays them out in two columns)
vizmemo <- bscols(widths = c(6, 6), m_top, m_bot)